home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops ƒ / PathsMod.txt < prev    next >
Text File  |  1995-07-05  |  2KB  |  74 lines
  1. \ We call this module if a list of HFS path designators is to be used to
  2. \ find a file.  First we grab the file with the list
  3. \ of path designators (one per line).  For each designator we prepend
  4. \ it to the given filename, and attempt to open the file.  We keep
  5. \ going until either the open succeeds or we run out of path designators.
  6. \ If the open succeeds we leave the name in the fcb set to the full
  7. \ path name.  If the open fails we restore the name to what it was.
  8.  
  9. objPtr        PATHS_F    class_is  file
  10. objHandle    PATHS_HDL
  11.  
  12. string        NAME
  13. string        FULLNAME
  14. string        PDS
  15.  
  16. local    OWP  { fcb mode \ ret? -- rc }
  17.  
  18. : OPENLOOP
  19.     BEGIN              \ Loop over path designators
  20.         len: pds
  21.         NIF                                        \ Not found
  22.             all: name  fcb name: file            \ Restore orig name
  23.             FNF  EXIT
  24.         THEN
  25.         RET  chsearch: pds  -> ret?
  26.         pds ->: fullName  name  $add: fullName
  27.         all: fullName  fcb name: file
  28.         fcb mode (open)  NIF  0  EXIT  THEN        \ Found
  29.         step: pds  ret? negate skip: pds
  30.     AGAIN  ;
  31.  
  32.  
  33. :loc OWP
  34.     reset: pds
  35.     len: pds  NIF  FNF  EXIT  THEN
  36.             \ If no paths, we return a "file not found" error.
  37.     getName: [ fcb ]
  38.     put: name  new: fullName
  39.     openLoop
  40.     release: name  release: fullName  ;loc
  41.  
  42.  
  43. : GETPATHS    \ ( addr len -- )
  44.     true -> use_paths?        \ This becomes the default now
  45.                     \  that GETPATHS has been called
  46.     keep: pathsMod
  47.     nil?: pds  IF  new: pds  ELSE  clear: pds  THEN
  48.     release: paths_hdl  ['] file  newObj: paths_hdl
  49.     obj: paths_hdl  -> paths_f
  50.     name: paths_f  openReadOnly: paths_f
  51.     IF
  52.         msg# 133        \ Warning - couldn't find paths file
  53.         release: paths_hdl  nilP -> paths_f  EXIT
  54.     THEN
  55.     size: paths_f  setsize: pds
  56.     all: pds  read: paths_f  drop
  57.     close: paths_f  drop  releaseObj: paths_hdl  ;
  58.  
  59.  
  60. : .PATHS  { \ ret? -- }
  61.     nil?: pds  ?EXIT
  62.     reset: pds
  63.     BEGIN
  64.         len: pds  0EXIT
  65.         RET  chsearch: pds  -> ret?
  66.         get: pds  type  cr
  67.         step: pds  ret? negate skip: pds
  68.     AGAIN  ;
  69.  
  70.  
  71. : REL    release: pds  ;
  72.  
  73. ' rel  setRelease
  74.